home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / TestNets.AmiCAD < prev    next >
Text File  |  2000-04-14  |  8KB  |  297 lines
  1. /* Test des erreurs sur un schéma, dans le but de créer une netlist.
  2.    Version 1.00: 14 Juillet 1998
  3.    Version 1.01: 6 février 1999 (ajout UNLOCK après erreur
  4.    Version 1.02: 27 février 1999 (ajout fonction INIT pour variables)
  5.    Version 1.03: 14 avril 2000 (adaptation version 2.05)
  6.    $VER: 1.03 (© R.Florac, 14/4/00) */
  7.  
  8. options results     /* indispensable pour récupérer le résultat des macros */
  9.  
  10. signal on error     /* pour l'interception des erreurs */
  11. signal on syntax
  12.  
  13. c=1
  14. 'INIT(B,D,L,O,N):SAVEALL:UNMARK(-1):OBJECTS'; objets=result
  15. 'DEF UNMARKCOMP(O)=IF(GETREF(O),UNMARK(GETREF(O)),0):IF(GETVAL(O),UNMARK(GETVAL(O)),0):UNMARK(O)'
  16.  
  17. modifs=0; eliminations=0; errrefs=0; errvals=0; errconx=0; doublets=0
  18. c="Test du schéma"||'0a'x||"1- Vérifier les références "||'0a'x||"2- Vérifier les valeurs    "||'0a'x||"3- Vérifier les connexions "||'0a'x||"4- Vérifier les liaisons   "||'0a'x||"5- Tester présence doublons"||'0a'x
  19. c=c||"6- Enchaîner tous les tests"||'0a'x||"7- Abandonner              "
  20. 'SELECT("'c'")'
  21. c=result
  22. select
  23.     when c=1 then call test_refs
  24.     when c=2 then call test_valeurs
  25.     when c=3 then call test_connexions
  26.     when c=4 then call test_liaisons
  27.     when c=5 then call test_doublets
  28.     when c=6 then do
  29.     call test_doublets
  30.     call test_refs
  31.     call test_valeurs
  32.     call test_connexions
  33.     call test_liaisons
  34.     end
  35.     otherwise do
  36.     'INIT(B,D,L,O,N)'
  37.     exit
  38.     end
  39. end
  40. call afficher_erreurs
  41. 'INIT(B,D,L,O,N)'
  42. exit
  43.  
  44. test_refs:
  45.     'LOCK:TITLE("Vérification des références...")'
  46.     do i=1 to objets
  47.     'TYPE(O='i')'
  48.     if result=1 then do
  49.         'PARTNAME(O)'
  50.         if result~="ALIMENTATION" & result ~="MASSE" then do
  51.         'GETREF(O)'
  52.         if result=0 then do
  53.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de référence"+CHR(10)+"Voulez-vous continuer?")'
  54.             if result<1 then do
  55.             'UNLOCK'
  56.             return
  57.             end
  58.             'UNMARKCOMP(O)'
  59.             errrefs=errrefs+1
  60.         end
  61.         end
  62.     end
  63.     end
  64.     'UNLOCK'
  65. return
  66.  
  67. test_valeurs:
  68.     'LOCK:TITLE("Vérification des valeurs..."):UNMARK(-1)'
  69.     do i=1 to objets
  70.     'TYPE(O='i')'
  71.     if result=1 then do
  72.         'PARTNAME(O)'
  73.         if result~="ALIMENTATION" & result ~="MASSE" then do
  74.         'GETVAL(O)'
  75.         if result=0 then do
  76.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"n''a pas de valeur"+CHR(10)+"Voulez-vous continuer?")'
  77.             if result<1 then do
  78.             'UNLOCK'
  79.             return
  80.             end
  81.             'UNMARKCOMP(O)'
  82.             errvals=errvals+1
  83.         end
  84.         end
  85.     end
  86.     end
  87.     'UNLOCK'
  88. return
  89.  
  90. test_doublets:
  91.     'LOCK:TITLE("Vérification absence éléments doubles..."):UNMARK(-1)'
  92.     i=1
  93.     do while i>0
  94.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  95.     if i>0 then do
  96.         'N=FINDOBJ('i+1',1,COL(O),LINE(O))'; j=result
  97.         if j>0 then do
  98.         'IF(PARTNAME(O)==PARTNAME(N),IF(GETREF(N),DELETE(GETREF(N)),0):IF(GETVAL(N),DELETE(GETVAL(N)),0):DELETE(N):MARK(O),0):OBJECTS'; objets=result
  99.         doublets=doublets+1
  100.         end
  101.         if i>=objets-1 then i=0
  102.         else i=i+1
  103.     end
  104.     end
  105.     i=1
  106.     do while i>0
  107.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  108.     if i>0 then do
  109.         'GETREF(O)'; r=result
  110.         if r>0 then do
  111.         'D=FINDREF('i+1',READTEXT(GETREF(O)))'; d=result
  112.         if d>0 then do
  113.             'MARK(O,D):MESSAGE("Attention: la référence"+CHR(10)+READTEXT(GETREF(O))+CHR(10)+"est utilisée deux fois!")'
  114.         end
  115.         end
  116.         if i>=objets-1 then i=0
  117.         else i=i+1
  118.     end
  119.     end
  120.     'UNLOCK'
  121. return
  122.  
  123. test_connexions:
  124.     'LOCK:TITLE("Vérification des liaisons aux composants..."):UNMARK(-1)'
  125.     i=1
  126.     do while i>0
  127.     'O=FINDOBJ('i',1,-1,-1)'; i=result
  128.     if i>0 then do
  129.         'PARTNAME(O)'
  130.         'DEVPINS(O)'; j=result
  131.         do k=1 to j
  132.         if connexion_broche(i,k)=0 then do
  133.             'MARK(O):REQUEST("Attention l''objet 'i'"+CHR(10)+"("+PARTNAME(O)+")"+CHR(10)+"situé en "+STR(COL(O))+" "+STR(LINE(O))+CHR(10)+"a sa borne "+STR(IF(PINNUM(O,'k'),PINNUM(O,'k'),'k'))+" non connectée"+CHR(10)+"Voulez-vous continuer?")'
  134.             if result<1 then do
  135.             'UNLOCK'
  136.             return
  137.             end
  138.             'UNMARKCOMP(O)'
  139.             errconx=errconx+1
  140.         end
  141.         end
  142.         if i=objets then leave
  143.         i=i+1
  144.     end
  145.     end
  146.     'UNLOCK'
  147. return
  148.  
  149. test_liaisons:
  150.     'LOCK:TITLE("Recherche et élimination lignes inutiles...")'
  151.     i=1
  152.     do while i>0
  153.     'O=FINDOBJ('i',2,-1,-1)'; i=result
  154.     if i>0 then do
  155.         'IF((COL(O)==ENDCOL(O))&(LINE(O)==ENDLINE(O)),DELETE(O),0)'
  156.         if result>0 then do
  157.         objets=result
  158.         eliminations=eliminations+1
  159.         end
  160.         else if i<objets then do
  161.         'IF(COL(O)==ENDCOL(O),1,IF(LINE(O)==ENDLINE(O),2,0))'
  162.         if result=1 then do    /* c'est une ligne verticale */
  163.             l=i+1
  164.             do while l>0
  165.             'L=FINDOBJ('l',2,COL(O),-1)'; l=result
  166.             if l>0 then do
  167.                 'IF(COL(L)==ENDCOL(L),COORDS(O)+","+COORDS(L),"")'
  168.                 if result~="" then do
  169.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  170.                 y4=min(y0,y1)
  171.                 y5=max(y0,y1)
  172.                 y6=min(y2,y3)
  173.                 y7=max(y2,y3)
  174.                 if y4<y7 & y5>y6 then call modifier_lignes(x0,min(y4,y6),x0,max(y5,y7))
  175.                 else if y4=y7 then do
  176.                     'FINDOBJ(1,7,'x0','y4')'
  177.                     if result=0 then call modifier_lignes(x0,y6,x0,y5)
  178.                 end
  179.                 else if y5=y6 then do
  180.                     'FINDOBJ(1,7,'x0','y5')'
  181.                     if result=0 then call modifier_lignes(x0,y4,x0,y7)
  182.                 end
  183.                 end
  184.             end
  185.             if l>0 then do
  186.                 if l>=objets then l=0
  187.                 else l=l+1
  188.             end
  189.             end
  190.         end
  191.         else if result=2 then do    /* c'est une ligne horizontale */
  192.             l=i+1
  193.             do while l>0
  194.             'L=FINDOBJ('l',2,-1,LINE(O))'; l=result
  195.             if l>0 then do
  196.                 'IF(LINE(L)==ENDLINE(L),COORDS(O)+","+COORDS(L),"")' /* est-ce bien une ligne horizontale? */
  197.                 if result~="" then do
  198.                 parse var result x0','y0','x1','y1','x2','y2','x3','y3
  199.                 x4=min(x0,x1)
  200.                 x5=max(x0,x1)
  201.                 x6=min(x2,x3)
  202.                 x7=max(x2,x3)
  203.                 if x4<x7 & x5>x6 then call modifier_lignes(min(x4,x6),y0,max(x5,x7),y0)
  204.                 else if x4=x7 then do
  205.                     'FINDOBJ(1,7,'x4','y0')'
  206.                     if result=0 then call modifier_lignes(x6,y0,x5,y0)
  207.                 end
  208.                 else if x5=x6 then do
  209.                     'FINDOBJ(1,7,'x5','y0')'
  210.                     if result=0 then call modifier_lignes(x4,y0,x7,y0)
  211.                 end
  212.                 end
  213.             end
  214.             if l>0 then do
  215.                 if l>=objets then l=0
  216.                 else l=l+1
  217.             end
  218.             end
  219.         end
  220.         end
  221.         if i>=objets-1 then i=0
  222.         else i=i+1
  223.     end
  224.     else leave
  225.     end
  226.     'UNLOCK'
  227. return
  228.  
  229. afficher_erreurs:
  230.     if eliminations=0 & modifs=0 & errrefs=0 & errvals=0 & errconx=0 & doublets=0 then 'MESSAGE("Vérification terminée"+CHR(10)+"Aucune erreur trouvée")'
  231.     else do
  232.     t=""
  233.     if eliminations>0 then t=eliminations||" lignes nulles éliminées"
  234.     if modifs>0 then do
  235.         if t~="" then t=t||'0a'x||modifs||" lignes modifiées"
  236.         else t=modifs||" lignes modifiées"
  237.     end
  238.     if errrefs>0 then do
  239.         if t~="" then t=t||'0a'x||errrefs||" références manquantes"
  240.         else t=errrefs||" références manquantes"
  241.     end
  242.     if errvals>0 then do
  243.         if t~="" then t=t||'0a'x||errvals||" valeurs manquantes"
  244.         else t=errvals||" valeurs manquantes"
  245.     end
  246.     if errconx>0 then do
  247.         if t~="" then t=t||'0a'x||errconx||" connexions manquantes"
  248.         else t=errconx||" connexions manquantes"
  249.     end
  250.     if doublets>0 then do
  251.         if t~="" then t=t||'0a'x||doublets||" éléments supprimés"
  252.         else t=doublets||" éléments supprimés"
  253.     end
  254.     'MESSAGE("'t'")'
  255.     end
  256.     return
  257.  
  258. modifier_lignes:
  259.     parse arg xd,yd,xf,yf
  260.     'DRAWMODE(1):DELETE(L):DELETE(O):MARK(DRAW('xd','yd','xf','yf'))'
  261.     objets=objets-1
  262.     i=0; l=0
  263.     modifs=modifs+1
  264.     return
  265.  
  266. connexion_broche: procedure
  267.     parse arg objet,broche
  268.     'PINCOL(O='objet',B='broche')'; xj=result
  269.     'PINLINE(O,B)'; yj=result
  270.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  271.     if xl>0 then return xl
  272.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  273.     if xl<=0 then return 0
  274.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  275.     if result>0 then return xl
  276.     return 0
  277.  
  278. min: procedure
  279.     parse arg v1,v2
  280.     if v1<v2 then return v1
  281.     return v2
  282.  
  283. max: procedure
  284.     parse arg v1,v2
  285.     if v1>v2 then return v1
  286.     return v2
  287.  
  288. /* Traitement des erreurs, interruption du programme */
  289. syntax:
  290. erreur=RC
  291. 'UNLOCK:MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):INIT(B,D,L,O,N)'
  292. exit
  293.  
  294. error:
  295. 'UNLOCK:MESSAGE("Erreur en ligne 'SIGL'"):INIT(B,D,L,O,N)'
  296. exit
  297.